home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS01.ADF / ABasicStuff / Graphics / Spiral.bas < prev    next >
BASIC Source File  |  1985-12-08  |  3KB  |  129 lines
  1. 10    '  ***** Spiralizer *****
  2. 20    '  **  hi-res (640X200) version **
  3. 30    '
  4. 40    '  ** Translated from the Atari 800 **
  5. 50    '  ** by David Milligan, 70707,2521  11/2/85    **
  6. 60    ' 
  7. 70    '  ***  This came out of an Atari magazine a couple
  8. 80    '  ***  of years ago, and I can't remember which one.
  9. 90    '  ***  The listing I worked off of had been severely
  10. 100   '  ***  hacked by someone trying to do graphic dumps
  11. 110   '  ***  to a DEC lineprinter, so it looks kinda rough.
  12. 120   '
  13. 130   '  ***  Another graphics toy, this does a pretty good
  14. 140   '  ***  job of mimicking the Spirographs we played with
  15. 150   '  ***  when we were kids, er, physically younger kids.
  16. 160   '
  17. 170   '
  18. 180   dim a$(3),x$(4)
  19. 190   ask window wid%,hi%:if wid%>600 then 210
  20. 200   screen 1,4,0
  21. 210   rgb 0,0,0,0:rgb 1,15,15,15
  22. 220   rgb 3,15,6,0
  23. 230   rgb 9,0,0,15:rgb 10,3,6,15
  24. 240   rgb 11,7,7,15:rgb 12,12,0,14
  25. 250   rgb 13,15,2,14
  26. 260   rgb 15,0,0,0
  27. 270   gosub 1070
  28. 280   goto 1160
  29. 290   g=4:z=5
  30. 300   scnclr
  31. 310   '
  32. 320   '  ****  Speed Input ****
  33. 330   '
  34. 340   ?" Speed (-50 to 50) ";:input x$
  35. 350   z=val(x$):if x$="" then z=5
  36. 360   if z<-50 or z>50 then z=5
  37. 370   k=z:? z:k=k-1
  38. 380   oldspeed=z
  39. 390   '
  40. 400   '  **** Radius Input ****
  41. 410   '
  42. 420   g=3:z=35:?" Radius (1-60) ";:input z
  43. 430   if z<1 or z>60 then z=35
  44. 440   r=z:? z:r=r+13:s=1
  45. 450   oldrad=z
  46. 460   '
  47. 470   '  **** Spin Input ****
  48. 480   '
  49. 490   z=1:?" Spin (1 to 18) ";:input a$:gosub 1010
  50. 500   if z<1 or z>18 then z=1:? z
  51. 510   oldspin=z
  52. 520   a=1/z:if z>1 and z<9 then 650
  53. 530   '
  54. 540   ' **** Movement Prompt ****
  55. 550   '
  56. 560   sm=1:m=2:?" Movement or Decrement (m/d)";
  57. 570   getkey x$
  58. 580   if x$="m" then sm=0:goto 610
  59. 590   if x$="d" then m=0:goto 610
  60. 600   m=0:sm=0:x$="none"
  61. 610   ?x$
  62. 620   '
  63. 630   '  **** Clear Screen Prompt ****
  64. 640   '
  65. 650   ?" Clear Screen (y/n) ";
  66. 660   getkey a$:if a$<>"n" then gosub 1060:goto 680
  67. 670   ? "no";
  68. 680   w=1:z=139:if m=2 then z=80:if a=1 then w=5:m=1:z=122
  69. 690   if sm-a=0 then w=5
  70. 700   if a<1 then k=k+a
  71. 710   c=1e-03:if a<1/9 then m=m/2:c=c/2
  72. 720   j=r:i=79-r
  73. 730   close #2
  74. 740   cmd 1
  75. 750   draw((z+20)*2,6)
  76. 760   col=2
  77. 770   pena col:rgb 0,0,0,0
  78. 780   rgb 15,0,0,0
  79. 790   '
  80. 800   '  ***  Main Loop ***
  81. 810   '
  82. 820   cnt=0
  83. 830   for t=0 to 6.2831/a*w step .06283
  84. 840   if sm then j=r*s:i=79*s-j:s=s-c
  85. 850   draw(to ((z+t*m-sin(t)*j+sin(t*k)*i)+20)*2,85-cos(t)*j-cos(t*k)*i)
  86. 860   cnt=cnt+1
  87. 870   if cnt>100 then cnt=0:col=col+1:if col=15 then col=2
  88. 880   pena col
  89. 890   ask mouse x%,y%,b%:if b%<>0 then 1160
  90. 900   next t
  91. 910   '
  92. 920   '  **** Poll Mouse Button ****
  93. 930   '
  94. 940   ask mouse x%,y%,b%:if b%=0 then 940
  95. 950   goto 1160
  96. 960   scnclr
  97. 970   rgb 0,6,9,15:rgb 1,0,0,0
  98. 980   rgb 15,11,11,11
  99. 990   goto 290
  100. 1000  '
  101. 1010  sign=1:if left$(a$,1)="-" then a$=mid$(a$,2):sign=-1
  102. 1020  z=0:for i=1 to len(a$):z=z*10+asc(mid$(a$,i,i))-48
  103. 1030  next i:z=sign*z:return
  104. 1040  '
  105. 1050  '
  106. 1060  cmd 1:scnclr:cmd 2:return
  107. 1070  window #1,0,0,640,200,"Spiralizer"
  108. 1080  cmd 1:graphic(1):return
  109. 1090  '
  110. 1100  '  ***  menu window  ***
  111. 1110  '
  112. 1120  window #2,0,10,250,110,"Spiralizer Menu"
  113. 1130  cmd 2:graphic(0):scnclr:return
  114. 1140  '
  115. 1150  '
  116. 1160  gosub 1120
  117. 1170  ? at(2,2);" Press '0' to exit"
  118. 1180  ? at(2,4);" Press any other key"
  119. 1190  ? at(2,5);" to begin."
  120. 1200  getkey a$
  121. 1210  if a$="0" then 1240
  122. 1220  scnclr
  123. 1230  goto 320
  124. 1240  gosub 1060
  125. 1250  close 2,1
  126. 1260  rgb 0,6,9,15:rgb 1,0,0,0
  127. 1270  rgb 15,11,11,11
  128. 1280  end
  129.